home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / data / happysrc / pcident.c < prev    next >
Text File  |  1993-11-30  |  8KB  |  253 lines
  1. /*************************************/
  2. /*                                   */
  3. /*  *** HAPPy Pascal compiler ***    */
  4. /*    identifier routine             */
  5. /*                                   */
  6. /*   Copyright (c) H.Asano 1992      */
  7. /*************************************/
  8.  
  9. #define  EXTERN  extern
  10.  
  11. #include <string.h>
  12. #include "pascomp.h"
  13.  
  14. extern void pcerr(int,char*) ;          /* エラーメッセージ出力処理   */
  15. extern int  crelabel(void)   ;
  16. extern void enterstdpf(void) ;          /* 標準手続き･関数名の登録処理*/
  17. extern void term(void) ;                /* 終了処理                   */
  18. extern void *Malloc(int) ;              /* メモリ確保処理             */
  19.  
  20.  
  21. /**************************************/
  22. /*  mkctp() : ctp型のエリアを確保する */
  23. /**************************************/
  24. ctp *mkctp(char *fname,enum idclass fklass,stp *fidtype,ctp *fnext)
  25. {
  26.   ctp *lcp ;
  27.  
  28.      lcp = (ctp*)Malloc(sizeof(ctp)) ;  /* ctp型エリアを確保          */
  29.  
  30.      strcpy(lcp->name,fname) ;          /* 名前の設定                 */
  31.      lcp->idtype = fidtype   ;          /* 型の設定                   */
  32.      lcp->next   = fnext     ;          /* 次へのリンクの設定         */
  33.      lcp->klass  = fklass    ;          /* 名前の種類の設定           */
  34.  
  35.      return(lcp) ;
  36. }
  37.  
  38. /**************************************/
  39. /*       enterid() :                  */ 
  40. /*         identifier を tree に登録  */
  41. /**************************************/
  42.  
  43. void enterid(ctp *fcp)
  44. {
  45.   ctp     *lcp;
  46.   ctp     *lcp1;
  47.   aplist  *lap ;
  48.   boolean lleft ;       /* 右か左に登録するかのフラグ lleft=true : 左 */
  49.   int     cmpresult;                    /* strcmp の 結果             */
  50.  
  51.     lap = display[top].aname ;          /* 定義より先に参照されたか   */
  52.     while(lap) {                        /* 調べる                     */
  53.      if(!strcmp(lap->name->name,fcp->name)) {
  54.       pcerr(100,fcp->name) ;            /* 宣言よりも先に参照された   */
  55.       return;
  56.      }
  57.      lap = lap->next ;
  58.     }
  59.  
  60.      lcp = display[top].fname;
  61.      if(!lcp) {
  62.       display[top].fname = fcp ;        /* その水準での最初の登録     */
  63.       fcp->llink = nil;
  64.       fcp->rlink = nil;
  65.       return;
  66.      }
  67.  
  68.      do {
  69.       lcp1 = lcp ;
  70.       if(!(cmpresult=strcmp(lcp->name, fcp->name))){/* 既に名前が存在する時 */
  71.        pcerr(101,lcp->name);                   /* 名前の二重定義エラー */
  72.        return ;                                /* 登録せずに打ち切り   */
  73.       }
  74.       else
  75.        if(cmpresult < 0) {                     /* 登録する名前が大きい時 */
  76.         lcp = lcp->rlink;                      /* 右側を探索             */ 
  77.         lleft = false;
  78.         }
  79.         else {                                 /* 登録する名前が小さい時 */
  80.          lcp = lcp->llink;                     /* 左側を探索             */
  81.          lleft = true ;
  82.         }
  83.      } while (lcp) ;
  84.  
  85.      if(lleft) lcp1->llink = fcp ;             /* 左側への登録           */
  86.      else      lcp1->rlink = fcp;              /* 右側への登録           */
  87.  
  88.      fcp->llink = nil;
  89.      fcp->rlink = nil;
  90. }
  91.  
  92. /*****************************************/
  93. /*   searchsection() :                   */ 
  94. /*    identifier を ある水準だけから探す */
  95. /*      ･ レコードの名前を処理する場合   */
  96. /*      ･ 前方参照された手続き･関数名    */
  97. /*****************************************/
  98. ctp *searchsection(ctp *fcp)
  99. {
  100.   int     cmpresult;                    /* strcmp の 結果             */
  101.      while(fcp) {
  102.       if(!(cmpresult=strcmp(id,fcp->name)))  /* 名前が一致した場合    */
  103.        return(fcp) ;
  104.       fcp = (cmpresult > 0) ? fcp->rlink : fcp->llink ;
  105.      }
  106.      return(nil) ;                      /* 見つからない場合           */
  107. }
  108.  
  109. /**************************************/
  110. /*       searchid() :                 */ 
  111. /*         identifier を 探す         */
  112. /**************************************/
  113. ctp *searchid(Set fidcls)
  114. {
  115.   ctp *lcp ;
  116.   boolean error103 = false ;
  117.   int     cmpresult;                    /* strcmp の 結果             */
  118.  
  119.      for(disx=top ; disx>=0 ; disx--) {   /* disxは共通変数            */
  120.                                           /* 名前が見つかった水準を示す*/
  121.       lcp = display[disx].fname ;
  122.       while(lcp) {
  123.        if(!(cmpresult=strcmp(id, lcp->name)))/* 名前が一致した         */
  124.         if(inset(fidcls,lcp->klass))      /* 属性が一致した            */
  125.          return(lcp) ;                    /*   その時のlcpを返す       */
  126.         else {                            /* 名前は一致したが属性が違う */  
  127.          pcerr(103,id) ;                  /* 名前の種類が適当でない　  */
  128.          error103 = true ;
  129.          break ;                          /* while loop を抜ける       */
  130.         }
  131.        else
  132.         lcp = (cmpresult > 0) ? lcp->rlink : lcp->llink ; 
  133.       }
  134.      }
  135.  
  136.      /* 見つからなかった時はlcp=nilでここに来る */
  137.  
  138.      if(! error103) pcerr(104,id) ;     /* 103エラーが出ていなければ
  139.                                    名前が宣言されていないエラーを出す */
  140.  
  141.      /* ポインタ型前方参照ではない時 
  142.           未定義用のエリアを返却する  */
  143.      if(inset(fidcls,types))  return(utypptr) ;   /* type 型の時 */
  144.      if(inset(fidcls,proc ))  return(uprcptr) ;   /* proc 型の時 */
  145.      if(inset(fidcls,vars ))  return(uvarptr) ;   /* var  型の時 */
  146.      if(inset(fidcls,field))  return(ufldptr) ;   /* field型の時 */
  147.      if(inset(fidcls,konst))  return(ucstptr) ;   /* const型の時 */
  148.      /* 上記以外=func */      return(ufctptr) ;   /* func 型の時 */
  149. }
  150.  
  151. /**************************************/
  152. /* applied() : 引用名チェーン処理     */
  153. /**************************************/
  154. void applied(ctp *fcp,int ftoplevel)
  155. {
  156.   aplist *lap ;
  157.   
  158.      lap = (aplist*)Malloc(sizeof(aplist));
  159.      lap->name = fcp ;
  160.      lap->next = display[ftoplevel].aname ;
  161.      display[ftoplevel].aname = lap ;
  162. }
  163.  
  164. /***********************************/
  165. /*   entdtdnames() : 標準名の登録  */
  166. /***********************************/
  167. void entstdnames(void)
  168. {
  169.   ctp *cp;
  170.   ctp *cp1;
  171.   int i;
  172.   char *name;
  173.  
  174.    /**** interger ****/
  175.      cp = mkctp("integer",types,intptr,nil) ;
  176.      enterid(cp);
  177.  
  178.    /**** real ****/
  179.      cp = mkctp("real",types,realptr,nil) ;
  180.      enterid(cp);
  181.  
  182.    /**** char ****/
  183.      cp = mkctp("char",types,charptr,nil) ;
  184.      enterid(cp);
  185.  
  186.    /**** boolean ****/
  187.      cp = mkctp("boolean",types,boolptr,nil) ;
  188.      enterid(cp);
  189.  
  190.    /**** text ****/
  191.      cp = mkctp("text",types,textptr,nil) ;
  192.      enterid(cp) ;
  193.  
  194.   /**** false,true ****/
  195.      cp1 = nil ;
  196.      for(i=0;i<=1;i++) {
  197.       name = (i==0) ? "false" : "true";
  198.       cp = mkctp(name,konst,boolptr,cp1) ;
  199.       cp->n.values.ival = i  ;          /* false=0; true=1            */
  200.       enterid(cp);
  201.       cp1 = cp  ;
  202.      }
  203.      boolptr->sf.sc.fconst = cp ;
  204.  
  205.    /**** maxint ****/
  206.      cp = mkctp("maxint",konst,intptr,nil) ;
  207.      cp->n.values.ival = Maxint ;       /* 整数の最大値               */
  208.      enterid(cp) ;
  209.  
  210.   /**** 標準手続き･関数の登録 ****/
  211.      enterstdpf() ;
  212. }
  213.  
  214. /**************************************/
  215. /*   entdundecl() :                   */
  216. /*     名前が未定義の時の代用名の登録 */
  217. /**************************************/
  218. void entundecl(void)
  219. {
  220.   /**** for types ****/
  221.      utypptr = mkctp(" ",types,nil,nil) ;
  222.  
  223.   /**** for const ****/
  224.      ucstptr = mkctp(" ",konst,nil,nil) ;
  225.      ucstptr->n.values.ival = 0 ;
  226.  
  227.   /**** for vars ****/
  228.      uvarptr = mkctp(" ",vars,nil,nil) ;
  229.      uvarptr->n.v.vkind = actual ;
  230.      uvarptr->n.v.vlev  = 0 ;
  231.      uvarptr->n.v.vaddr = 0 ;
  232.  
  233.   /**** for field ****/
  234.      ufldptr = mkctp(" ",field,nil,nil) ;
  235.      ufldptr->n.fldaddr = 0  ;
  236.  
  237.   /**** for procedure ****/
  238.      uprcptr = mkctp(" ",proc,nil,nil) ;
  239.      uprcptr->n.pf.pfdeckind          = declared   ;
  240.      uprcptr->n.pf.sd.d.pfkind        = actual     ;
  241.      uprcptr->n.pf.sd.d.pflev         = 0          ;
  242.      uprcptr->n.pf.sd.d.af.a.pfname   = crelabel() ;
  243.      uprcptr->n.pf.sd.d.af.a.forwdecl = false      ;
  244.  
  245.   /**** for function ****/
  246.      ufctptr = mkctp(" ",func,nil,nil) ;
  247.      ufctptr->n.pf.pfdeckind          = declared   ;
  248.      ufctptr->n.pf.sd.d.pfkind        = actual     ;
  249.      ufctptr->n.pf.sd.d.pflev         = 0          ;
  250.      ufctptr->n.pf.sd.d.af.a.pfname   = crelabel() ;
  251.      ufctptr->n.pf.sd.d.af.a.forwdecl = false      ;
  252. }
  253.